(SETQ IBASE (ADD1 7)) 


(DEFPROP ALLFNS 
 (NIL WAIT
      RUNNER
      FATAL
      TJOINT
      K1
      TEST!
      G
      FOLDED
      VISIBLE
      POTENT
      JOTBIT
      JUTBIT
      MAKETILE
      VFCCW
      DETSEG
      SHOW9
      *TEST
      EXCH
      SEENOD
      GLUETILE
      TEST2
      TEST
      TYPE
      COPYPOS
      COPYFACE1
      GARG
      FACEUP) 
VALUE)

(DEFPROP WAIT 
 (LAMBDA NIL
  (PROG (TMP TMP2)
	(SETQ TMP (DDTIN T))
	(SETQ TMP2 (TYI))
	(DDTIN TMP)
	(COND ((EQ TMP2 104) (BREAK WAIT)) (T NIL)))) 
EXPR)

(DEFPROP RUNNER 
 (LAMBDA NIL
  (PROG NIL
	(SHOW9 1)
	(TEST2)
	(PRINQ PASS 1 COMPLETED /././.)
	(*TEST)
	(PRINQ PASS2 COMPLETED)
	(TERPRI)
	(KLTMPS WORLD)
	(GEODPY)
	(GPUSH IMAGE)
	(STADPY))) 
EXPR)

(DEFPROP FATAL 
 (LAMBDA (L) (PROG2 NIL (PRINL L) (FIX T))) 
FEXPR)

(DEFPROP TJOINT 
 (LAMBDA (N) (NED N)) 
EXPR)

(DEFPROP K1 
 (NIL . 0.13698630E-1) 
VALUE)

(DEFPROP TEST! 
 (LAMBDA NIL
  (PROG (FACE)
	(SETQ IMAGE (MKB WORLD))
	(SETQ FACE (PFACE WORLD))
   LOOP (COPYFACE1 FACE)
	(SETQ FACE (ALT2 FACE))
	(COND ((EQ FACE 0) (RETURN T)) (T (GO LOOP))))) 
EXPR)

(DEFPROP G 
 (LAMBDA NIL (GEOMED)) 
EXPR)

(DEFPROP FOLDED 
 (NIL . 100000000) 
VALUE)

(DEFPROP VISIBLE 
 (NIL . 40000000) 
VALUE)

(DEFPROP POTENT 
 (NIL . 20000000) 
VALUE)

(DEFPROP JOTBIT 
 (NIL . 20000000000) 
VALUE)

(DEFPROP JUTBIT 
 (NIL . 40000000000) 
VALUE)

(DEFPROP MAKETILE 
 (LAMBDA(CALLFACE)
  (PROG (FACE E0 E1 FNEW VNEW V0 VT JOTFLAG EOP VOP)
	(PROG2 (GPUSH CALLFACE) (STADPY) (GPOP))
	(SETQ E0 (SETQ E1 (PED CALLFACE)))
	(SETQ E1 E0)
   VSLOOP
	(COND ((TEST E1 VISIBLE) NIL)
	      ((EQ E0 (SETQ E1 (ECCW E1 CALLFACE)))
	       (RETURN (PROG2 (PRINQ POTENT FACE WITHOUT VISIBLE EDGE FOUND) 0)))
	      (T (GO VSLOOP)))
	(SETQ JOTFLAG NIL)
	(SETQ FACE CALLFACE)
	(SETQ E0 E1)
	(SETQ FNEW (MKF IMAGE))
	(SETQ V0 (MKV IMAGE))
	(SETQ VNEW V0)
	(SETQ EOP (FUNCTION ECCW))
	(SETQ VOP (FUNCTION VCCW))
   LOOP (COPYPOS VNEW (VOP E1 FACE))
	(ROG NIL (GPUSH FACE) (GPUSH E1) (STADPY) (WAIT) (GPOP) (GPOP))
	(COND (JOTFLAG
	       (COND ((TEST (VOP E1 FACE) (*PLUS JUTBIT JOTBIT))
		      (PROG NIL
			    (SETQ VT (TJOINT (VOP E1 FACE)))
			    (SETQ FACE (PFACE (PED VT)))
			    (COND ((TEST VT JOTBIT)
				   (PROG NIL
					 (SETQ EOP (FUNCTION ECCW))
					 (SETQ VOP (FUNCTION VCCW))
					 (COND ((TEST FACE POTENT) NIL) (T (SETQ FACE (NFACE (PED VT)))))
					 (COND ((EQ FACE CALLFACE) (SETQ JOTFLAG T)) (T NIL))))
				  (T
				   (PROG NIL
					 (SETQ EOP (FUNCTION ECW))
					 (SETQ VOP (FUNCTION VCW))
					 (COND ((TEST FACE POTENT) (SETQ FACE (NFACE (PED VT)))) (T NIL)))))
			    (SETQ E1 (EOP VT FACE))))
		     (T
		      (PROG NIL
			    (SETQ VT (VOP E1 FACE))
 		       ELOOP
			    (COND ((TEST (SETQ E1 (ECW E1 VT)) VISIBLE) NIL) (T (GO LOOP)))
			    (SETQ FACE (FCCW E1 VT))))))
	      ((TEST (ECCW E1 FACE) VISIBLE) (SETQ E1 (ECCW E1 FACE)))
	      (T
	       (PROG NIL
		     (SETQ VT (TJOINT (VCCW E1 FACE)))
		     (SETQ FACE (PFACE (PED VT)))
		     (COND ((TEST FACE POTENT) (SETQ FACE (NFACE (PED VT)))) (T NIL))
		     (SETQ E1 (ECCW VT FACE))
		     (SETQ JOTFLAG T)
		     (BREAK TJ))))
	(COND ((EQ E0 E1)
	       (RETURN
		(PROG NIL
		      (SETQ E0 (INVERT (MKFE V0 FNEW VNEW)))
		      (ALT/. E1 E0)
		      (ALT/. E0 E1)
		      (SETQ FNEW (PFACE FNEW))
		      (ALT/. FACE FNEW)
		      (ALT/. FNEW FACE)
		      (RETURN FNEW))))
	      (T (SETQ VNEW (MKEV FNEW VNEW))))
	(ALT/. E1 (PED VNEW))
	(ALT/. (PED VNEW) E1)
	(GO LOOP))) 
EXPR)

(DEFPROP VFCCW 
 (LAMBDA (F V) (VCCW (ECCW V F) F)) 
EXPR)

(DEFPROP DETSEG 
 (LAMBDA NIL (UUO 400017)) 
EXPR)

(DEFPROP SHOW9 
 (LAMBDA(POG)
  (PROG NIL (PPROJ CAMERA WORLD) (FMRK WORLD) (EMRK WORLD) (OCCULT WORLD) (CLIPER WINDOW) (IIIDPY WINDOW POG))) 
EXPR)

(DEFPROP *TEST 
 (LAMBDA NIL
  (PROG (E1 E2)
	(SETQ E1 (PED IMAGE))
   LOOP (PROG2 (GPUSH E1) (STADPY) (GPOP))
	(COND ((EQ E1 (SETQ E2 (ALT (ALT E1)))) NIL) (T (GLUETILE E2 E1)))
	(COND ((EQ (SETQ E1 (PED E1)) IMAGE) (RETURN)) (T (GO LOOP))))) 
EXPR)

(DEFPROP EXCH 
 (LAMBDA (L) (PROG (TMP) (SETQ TMP (EVAL (CAR L))) (SET (CAR L) (EVAL (CADR L))) (SET (CADR L) TMP))) 
FEXPR)

(DEFPROP SEENOD 
 (LAMBDA (L) (PROG NIL (GPUSH L) (GEODPY) (STADPY) (GPOP))) 
EXPR)

(DEFPROP GLUETILE 
 (LAMBDA(E1 E2)
  (PROG (UF1 UF2 ENEW1 ENEW2 V1 V2 U1 U2)
	(SETQ V1 (NVT E1))
	(SETQ V2 (PVT E1))
	(SETQ U1 (PVT E2))
	(SETQ U2 (NVT E2))
	(SETQ UF1 (NFACE E1))
	(SETQ UF2 (NFACE E2))
	(RETURN
	 (COND ((AND (EQ V1 V2) (EQ U1 U2)) (PROG NIL (KLFE E1) (RETURN E2)))
	       ((OR (EQ V1 U1) (EQ V2 U2))
		(PROG NIL
		      (COND ((EQ V2 U2) (PROG NIL (EXCH V1 V2) (EXCH U1 U2))) (T NIL))
		      (SETQ ENEW1 (MKFE V2 UF1 U2))
		      (KLFE E1)
		      (KLVE ENEW1)
		      (RETURN E2)))
	       (T
		(PROG NIL
		      (SETQ ENEW1 (GLUEE UF1 V1 UF2 U1))
		      (SETQ ENEW2 (MKFE V2 UF1 U2))
		      (KLFE E1)
		      (KLVE ENEW1)
		      (KLVE ENEW2)
		      (RETURN E2))))))) 
EXPR)

(DEFPROP TEST2 
 (LAMBDA NIL
  (PROG (FACE)
	(SETQ IMAGE (MKB WORLD))
	(SETQ FACE (PFACE WORLD))
   LOOP (MAKETILE FACE)
	(SETQ FACE (ALT2 FACE))
	(COND ((EQ FACE 0) (RETURN T)) (T (GO LOOP))))) 
EXPR)

(DEFPROP TEST 
 (LAMBDA (NODE BITS) (NOT (EQ (BOOLE 1 (TYPE NODE) BITS) 0))) 
EXPR)

(DEFPROP TYPE 
 (LAMBDA (N) (EXAMINE N)) 
EXPR)

(DEFPROP COPYPOS 
 (LAMBDA(VNEW VOLD)
  (LIST (XWC/. VNEW (*TIMES K1 (XDC VOLD))) (YWC/. VNEW (*TIMES K1 (YDC VOLD))) (ZWC/. VNEW 0))) 
EXPR)

(DEFPROP COPYFACE1 
 (LAMBDA(FACE)
  (PROG (VNEW E0 E1 FNEW)
	(SETQ E0 (PED FACE))
	(SETQ FNEW (MKF IMAGE))
	(SETQ V0 (MKV IMAGE))
	(SETQ VNEW V0)
	(SETQ E1 E0)
   LOOP (COPYPOS VNEW (VCCW E1 FACE))
	(SETQ E1 (ECCW E1 FACE))
	(COND ((EQ E0 E1)
	       (RETURN
		(PROG NIL
		      (SETQ E0 (INVERT (MKFE V0 FNEW VNEW)))
		      (ALT/. E1 E0)
		      (ALT/. E0 E1)
		      (SETQ FNEW (PFACE FNEW))
		      (ALT/. FACE FNEW)
		      (ALT/. FNEW FACE))))
	      (T (SETQ VNEW (MKEV FNEW VNEW))))
	(ALT/. E1 (PED VNEW))
	(ALT/. (PED VNEW) E1)
	(GO LOOP))) 
EXPR)

(DEFPROP GARG 
 (LAMBDA (N) (EXAMINE (*DIF (BOOLE 1 PDLPTR 777777) (SUB1 N)))) 
EXPR)

(DEFPROP FACEUP 
 (LAMBDA(VERTEX)
  (PROG (FACE)
	(SETQ FACE (PFACE (PED VERTEX)))
	(COND ((TEST FACE POTENT) NIL) (T (SETQ FACE (NFACE (PED VERTEX)))))
	(RETURN FACE))) 
EXPR)